Shareware Grab Bag/Shareware Grab Bag.iso/007/copascal.arc/COPASCAL.LIS

File List | 1985-11-24 | 9.5 KB | 350 lines

Listing  program ADD1( Input, Output );
 # 1a
         var X : integer;

         procedure p1;
         var k : integer;
         begin
           for k := 1 to 50 do X := X + 1;
         end;

         procedure p2;
         var k : integer;
         begin
           for k := 1 to 50 do X := X + 1;
         end;

         begin  { main }
           X := 0;
           cobegin
             p1; p2
           coend;
           writeln( X );
         end.


         OUTPUT for 10 runs:   62  57  73  60  65  59  57  69  79  80



Listing  program ADD1( Input, Output );
 # 1b
         var X : integer;

         procedure p1;
         var k : integer;
         begin
           for k := 1 to 50 do begin
             write(' before: ', X:4 );
             X := X + 1;
             writeln(' After: ', X:4 );
           end;
         end;

         procedure p2;
         var k : integer;
         begin
           for k := 1 to 50 do begin
             write(' before: ', X:4 );
             X := X + 1;
             writeln(' After: ', X:4 );
           end;
         end;

         begin  { main }
           X := 0;
           cobegin
             p1; p2
           coend;
           writeln( X );
         end.


         OUTPUT for 10 runs:   86  81  87  87  81  84  87  85  81  78

         TEXT OUTPUT for 1 run:

         before:  before:    0 after:    1
         before:    1   0 after:    2
         before:  after:    2   2 after:    3
         before:    3
         after:    4
         before:    4 before:    4 after:    5
         before:  after:    5
         before:    5   5 after:    6
         before:  after:    6
           6 before:    6 after:    7 after:    7

         before:  before:    7 after:    8
           7 before:  after:    9
         before:    9   9 after:   10
         after:   10
         before:  before:   10 after:   10 after:   12
         before:   11
          12 after:   13
         before:   13 after:   14
         before:  before:   14 after:   15  15
         before:   15 after:   16
         before:   16 after:   17
         before:   17 after:   18
         after:   18 before:   18 after:
         before:   19
         before:   19  19 after:   20
         after:  before:   21
         before:   21 after:   22
          21 after:   23
         before:  before:   23 after:   24
         before:   23 after:   25
          24 after:  before:   26
         before:   26 after:   27
         before:   26 after:   28
         before:   27  28 after:   29
         before:  after:   29
         before:   29  29 after:  after:   30
         before:   30  30
         after:   31
         before:   31 before:   32 after:   32
         after:   33
         before:   33 before:  after:   33  34
         before:  after:   35
         before:   35  34 after:   36
         before:   36 after:  after:   37
         before:   37 after:   38
         before:   38 after:   39
         after:   39
         before:  before:   39  39 after:  after:   40
          40
         before:   40 after:  before:   41 after:   41
         before:   42
          42 after:   43
         before:   43 after:  before:   44 after:   45
         before:   44
         before:   45 after:   46
         before:   46 after:   47
          45 before:   48 after:   48
         before:   48 after:   49
         before:  after:   50  50
         before:   50 after:   51
         before:   51 after:   51
         after:  before:   52  52
         before:  after:   53  52
         after:   54
         before:  before:   54 after:   55
         before:   55  54 after:  after:   56  56
         before:
         before:   56 after:   57
          56 after:   58
         before:  before:   58  58 after:  after:   60
          60 before:   60
         before:   60 after:   61
         before:  after:   61
         before:   62  62
         after:  before:   63
         before:   63  63 after:  after:   64
         before:   64 after:   65  64
         before:   65 after:   66
         before:
          66 before:   66 after:   67
         after:   67
         before:   67 before:   68 after:  after:   69
          69
         before:   69 after:   70 before:   70
         before:   70 after:   71
         before:  after:   71
          71 after:   72
         before:   72 after:  before:   73  73
         before:   73 after:  after:   75
         before:   74
         before:   75  75 after:   76
         before:  after:   76
          76 after:   77
         before:   77 after:   78
         before:   78 after:   79
         before:   79 after:   80
         before:   80 after:   81

         final value := 81



Listing  program ADD2( Input, Output );
 # 1c
         type semaphore = integer;

         var X : integer;
             s : semaphore;

         procedure p1;
         var k : integer;
         begin
           for k := 1 to 50 do begin
             WAIT(s);
             X := X + 1;
             SIGNAL(s);
           end;
         end;

         procedure p2;
         var k : integer;
         begin
           for k := 1 to 50 do begin
             WAIT(s);
             X := X + 1;
             SIGNAL(s);
           end;
         end;

         begin  { main }
           X := 0;
           s := 1;
           cobegin
             p1; p2
           coend;
           writeln( X );
         end.


         OUTPUT:  100



Listing  program SUM_SQ1( Input, Output );
 # 2
         var a,b, f : integer;

         procedure SUM( var v:integer ; lo,hi : integer );
         var k : integer;
         begin
           v := 0;
           for k := lo to hi do  v := k*k + v;
         end;

         begin  { main }
           cobegin
             SUM( a,  1,  50 );
             SUM( b, 51, 100 );
           coend;
           f := a + b;
           writeln( 'sum of the squares : ', f:1 );
         end.


         OUTPUT:  sum of the squares : 10670



Listing  program SUM_SQ2( Input, Output );
 # 3
         const n = 9;

         type semaphore = integer;

         var  aTOb : array [1..10] of semaphore;
              sum  : array [1.. 9]   of integer;
              s    : semaphore;
              i    : integer;

         procedure SQ( x : integer );
         begin
           sum[x] := X*X;
           SIGNAL(s);
           WAIT( aTOb[x] );
           if x <> 1 then write( '+');
           write( sum[x]:4 );
           SIGNAL( aTOb[x+1] );
         end;

         procedure TOTAL;
         var T,i : integer;
         begin
           WAIT(s);
           SIGNAL( aTOb[1] );
           T := 0;
           for i := 1 to n do T := T + sum[i];
           WAIT( aTOb[n+1] );
           writeln( ' = ', T:1 );
         end;

         begin  { main }
           s := 1-n;
           for i := 1 to n+1 do aTOb[i] := 0;
           cobegin
             SQ(1);SQ(2);SQ(3);SQ(4);SQ(5);SQ(6);SQ(7);SQ(8);SQ(9);
             TOTAL
           coend;
         end.


         OUTPUT:   1+   4+   9+  16+  25+  36+  49+  64+  81 = 285



Listing  program CigSmok( Input, Output );
 # 4     const NumCig    =      10;  {  # of cigarettes for each smoker }
               paper     =       1;  {      .                           }
               match     =       3;  {      .   Resources               }
               tobacco   =       5;  {      .                           }

         type  semaphore = integer;
               resource  = integer;

         var   S     : array[ 1..8 ] of semaphore;
               alive : array[ 1..8 ] of boolean;
               a     : semaphore;
               k     : integer;

         function VALID( a,b : resource ): boolean;
         begin
           VALID := FALSE;
           if ( ODD(a) AND ODD(b) AND ( a <> b ) ) then
             if alive[ a+b ] then VALID := TRUE;
         end;

         procedure agent;
         var r1,r2 : resource;
             j     : integer;
         begin
           for j := 1 to 3*NumCig do begin
             WAIT(a);
             repeat
               r1 := 1 + RANDOM( 4 );
               r2 := 1 + RANDOM( 4 );
             until VALID( r1, r2 );
             SIGNAL( S[ r1+r2 ] );
           end;
         end;

         procedure smoker( r3 : resource );
         var i : resource;
             j : integer;
         begin
           i := ( paper + match + tobacco ) - r3;
           for j := 1 to NumCig do begin
             WAIT( S[ i ] );
             writeln( r3:3 );
             if ( j = NumCig ) then alive[i] := FALSE;
             SIGNAL(a);
           end;
         end;

         begin
           a := 1;
           for k := 1 to 8 do S[k] := 0;  { Zero Semaphore array }
           for k := 1 to 8 do alive[k] := TRUE;
           cobegin
             agent;
             smoker( paper );  smoker( match );  smoker( tobacco )
           coend;
         end.


         OUTPUT:   1    4    4    4    4    4    1    1    4    1
                   1    1    4    4    2    2    2    1    2    4
                   4    2    1    2    2    1    1    2    2    2


         OUTPUT:   4    4    2    4    1    1    4    4    4    2
                   1    2    2    1    2    4    4    4    2    1
                   4    2    1    2    2    1    1    2    1    1